home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / ICON_8 / CALLING_ / ICONVAL.C < prev    next >
C/C++ Source or Header  |  1990-04-08  |  2KB  |  81 lines
  1. /*
  2.  *  Demonstration program to call an Icon procedure with arguments.  This
  3.  *  program is used as
  4.  *
  5.  *    iconval iprog proc arg1 arg2 ...
  6.  *
  7.  *  where iprog is the name of the Icon icode file, proc is the name of
  8.  *  a procedure in it, and arg1, arg2, ... are arguments passed to proc.
  9.  *  It prints out the result if proc succeeds or notes if the procedure fails.
  10.  *  It prints a diagnostic message if proc is not a procedure in iprog.
  11.  */
  12.  
  13. #include "../h/config.h"
  14. #include "../h/rt.h"
  15. #include "rproto.h"
  16.  
  17.  
  18. extern int call_error;
  19.  
  20. novalue main(argc,argv)
  21.  
  22. int argc;
  23. char *argv[];
  24.    {
  25.    int clargc;
  26.    char **clargv;
  27.    dptr retval, iargv;
  28.    int i;
  29.    char sbuf[MaxCvtLen];
  30.  
  31.    /*
  32.     * Read in the icode file argv[1] and initialize the Icon system.
  33.     *  This must be done for any C program calling Icon.
  34.     */
  35.    icon_init(argv[1]);
  36.  
  37.    /*
  38.     * Skip the names of the executable and the file it processes.  It
  39.     *  is only necessary to get the the procedure name and its arguments from
  40.     *  the command line.
  41.     */
  42.    clargv = argv + 2;
  43.    clargc = argc - 3;
  44.  
  45.    fprintf(stderr,"program=%s\n",*clargv);
  46.    fflush(stderr);
  47.    /*
  48.     * Malloc space for the list of descriptors and create Icon qualifiers
  49.     *  for each argument.
  50.     */
  51.    iargv = (dptr)malloc(clargc * sizeof(struct descrip));
  52.    for (i = 0; i < clargc; i++) {
  53.       StrLoc(iargv[i]) = clargv[i + 1];
  54.       StrLen(iargv[i]) = strlen(clargv[i + 1]);
  55.      } 
  56.    retval = icon_call(*clargv, clargc, iargv);
  57.    if (call_error) {
  58.       fprintf(stderr,"procedure not found\n");
  59.       fflush(stderr);
  60.       c_exit(ErrorExit);
  61.       }
  62.    if (retval == NULL)
  63.       fprintf(stdout,"evaluation failed\n");
  64.    else {
  65.       /* Check type of result returned.  Don't attempt to print anything
  66.        *  but strings and integers here.
  67.        */
  68.       if (Qual(*retval)) {
  69.         qtos(retval,sbuf);
  70.         fprintf(stdout,"\"%s\"\n",sbuf);
  71.         }
  72.       else if (Type(*retval) == T_Integer)
  73.         fprintf(stdout,"%ld\n",IntVal(*retval));
  74.       else
  75.         fprintf(stdout,"type=%d\n",Type(*retval));
  76.       fflush(stdout);
  77.       }
  78.    c_exit(NormalExit);
  79.  
  80.    }
  81.